Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/parsed/parse.frm

Text File | 1995-05-02 | 10KB | 359 lines

VERSION 2.00
Begin Form frmParse
   Caption         =   "Parse Demo Main Menu"
   ClientHeight    =   5685
   ClientLeft      =   75
   ClientTop       =   645
   ClientWidth     =   9450
   Height          =   6375
   Left            =   15
   LinkTopic       =   "Form1"
   ScaleHeight     =   5685
   ScaleWidth      =   9450
   Top             =   15
   Width           =   9570
   Begin SpinButton Spin1
      Delay           =   100
      Enabled         =   0   'False
      Height          =   345
      Left            =   8385
      Top             =   1635
      Width           =   270
   End
   Begin CommandButton cmdMulti
      Caption         =   "&Multiple Char. Delim Test"
      Height          =   360
      Left            =   6135
      TabIndex        =   10
      Top             =   330
      Width           =   2580
   End
   Begin OptionButton optParse
      Caption         =   "Pars&eAndFillArray2%()"
      Height          =   270
      Index           =   1
      Left            =   525
      TabIndex        =   1
      Top             =   915
      Width           =   4965
   End
   Begin OptionButton optParse
      Caption         =   "Pars&eAndFillArray1%()"
      Height          =   270
      Index           =   0
      Left            =   525
      TabIndex        =   0
      Top             =   570
      Value           =   -1  'True
      Width           =   4965
   End
   Begin CommandButton cmdProcess
      Caption         =   "&Process Text"
      Height          =   390
      Left            =   6810
      TabIndex        =   3
      Top             =   2085
      Width           =   1965
   End
   Begin TextBox txtFileContents
      Height          =   3060
      Left            =   270
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   4
      Top             =   1995
      Width           =   5910
   End
   Begin CommandButton cmdSelectFile
      Caption         =   "&Select File"
      Height          =   345
      Left            =   345
      TabIndex        =   2
      Top             =   1485
      Width           =   1965
   End
   Begin Shape Shape3
      Height          =   1095
      Left            =   5835
      Shape           =   4  'Rounded Rectangle
      Top             =   165
      Width           =   3405
   End
   Begin Shape Shape2
      Height          =   4230
      Left            =   105
      Shape           =   4  'Rounded Rectangle
      Top             =   1380
      Width           =   9225
   End
   Begin Label lblReDimInt
      BorderStyle     =   1  'Fixed Single
      Caption         =   "10"
      ForeColor       =   &H00C0C0C0&
      Height          =   285
      Left            =   7830
      TabIndex        =   14
      Top             =   1635
      Width           =   420
   End
   Begin Label Label2
      Caption         =   "ReDim Interval:"
      ForeColor       =   &H00C0C0C0&
      Height          =   270
      Left            =   6315
      TabIndex        =   13
      Top             =   1635
      Width           =   1425
   End
   Begin Label lblLineCountAdj
      BorderStyle     =   1  'Fixed Single
      Height          =   795
      Left            =   6495
      TabIndex        =   12
      Top             =   3345
      Width           =   2655
   End
   Begin Label lblLineCount
      BorderStyle     =   1  'Fixed Single
      Height          =   690
      Left            =   6495
      TabIndex        =   11
      Top             =   2595
      Width           =   2655
   End
   Begin Label lblWordCount
      BorderStyle     =   1  'Fixed Single
      Height          =   330
      Left            =   6495
      TabIndex        =   9
      Top             =   4215
      Width           =   2655
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Select Function To Test:"
      Height          =   270
      Left            =   1590
      TabIndex        =   8
      Top             =   255
      Width           =   2475
   End
   Begin Shape Shape1
      Height          =   1200
      Left            =   420
      Shape           =   4  'Rounded Rectangle
      Top             =   150
      Width           =   5160
   End
   Begin Label lblFileLen
      BorderStyle     =   1  'Fixed Single
      Height          =   330
      Left            =   360
      TabIndex        =   7
      Top             =   5145
      Width           =   3090
   End
   Begin Label lblInfo
      BorderStyle     =   1  'Fixed Single
      Height          =   750
      Left            =   6495
      TabIndex        =   6
      Top             =   4605
      Width           =   2655
   End
   Begin Label lblFileName
      BorderStyle     =   1  'Fixed Single
      Height          =   300
      Left            =   2610
      TabIndex        =   5
      Top             =   1530
      Width           =   3435
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFileExit
         Caption         =   "E&xit"
         Shortcut        =   ^X
      End
   End
   Begin Menu mnuInfo
      Caption         =   "&Info!"
   End
End
Option Explicit

Sub cmdMulti_Click ()
   Screen.MousePointer = HOURGLASS
   Load frmMultiDelim

   If optParse(0).Value = True Then
      frmMultiDelim!lblCurRoutine = "ParseAndFillArray1%()"
   Else
      frmMultiDelim!lblCurRoutine = "ParseAndFillArray2%()"
   End If

   frmMultiDelim.Show NORMAL
   Me.WindowState = MINIMIZED
End Sub

Sub cmdProcess_Click ()
   Dim LineCount%, LineCountAdj%, WordCount%
   Dim ret%, SetReDim%
   Dim NewString$
   Dim crlf$, SpaceChar$
   Dim DynArray$()
   Dim CurTime!, NewTime!, TotalTime!

   'set delimiters
   crlf$ = Chr$(13) & Chr$(10)
   SpaceChar$ = Chr$(32)

   'clear previous displayed info
   lblLineCount = ""
   lblLineCountAdj = ""
   lblWordCount = ""
   lblInfo = ""
   'allow these labels to clear
   DoEvents

   'NOTE: In a previous program
   'I also tested QuickPak Professional parse routines
   'and VideoSoft VSAWK (VSVBX). If
   'you come up with a faster routine, just add it to
   'this project and create another optParse radio button
   'for it.

   Screen.MousePointer = HOURGLASS

   'call appropriate proc.
   If optParse(0).Value = True Then
   'use ParseAndFillArray1% function
      CurTime! = Timer
      LineCount% = ParseAndFillArray1%((txtFileContents), crlf$, DynArray$())
      'build a new string with crlf's replaced by Chr$(32) 's
      'LineCountAdj% passed byref. and filled with adjusted value for # lines
      NewString$ = ProcessArray$(DynArray$(), Chr$(32), LineCountAdj%)
      'erase array storage
      Erase DynArray$
      'get word count by passing processed string with all spaces
      WordCount% = ParseAndFillArray1%(NewString$, SpaceChar$, DynArray$())
      NewTime! = Timer
      MsgBox "ParseAndFillArray1%() Completed.", MB_ICONINFORMATION
   Else  'If optParse(1).Value = True
      'get ReDim setting from user
      'assign the Redim setting
      SetReDim% = ret%
      CurTime! = Timer
      LineCount% = ParseAndFillArray2%((txtFileContents), crlf$, DynArray$(), CInt(lblReDimInt))
      'build a new string with crlf's replaced by Chr$(32) 's
      'LineCountAdj% passed byref. and filled with adjusted value for # lines
      NewString$ = ProcessArray$(DynArray$(), Chr$(32), LineCountAdj%)
      'erase array storage
      Erase DynArray$
      'get word count by passing processed string with all spaces
      WordCount% = ParseAndFillArray2%(NewString$, SpaceChar$, DynArray$(), 10)
      NewTime! = Timer
      MsgBox "ParseAndFillArray2%() Completed.", MB_ICONINFORMATION
   End If

   Screen.MousePointer = DEFAULT

   'display the info
   'line count
   lblLineCount = "Number of Lines (including extra CRLF pairs): " & CStr(LineCount%)
   '